home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / nannws34.zip / OPNMODES.PRG < prev    next >
Text File  |  1989-01-01  |  6KB  |  208 lines
  1. * Program: OpnModes.prg
  2. * Author:  David Morgan
  3. * Version: Clipper Summer '87
  4. *
  5. * Copyright (c) 1988 Nantucket Corp.
  6.  
  7. CLEAR
  8. SET WRAP ON
  9.  
  10. DECLARE inheritance[2], sharing[5], access[3]
  11. inheritance[1] = 'inherited'
  12. inheritance[2] = 'private'
  13. sharing[1]     = 'compatibility'
  14. sharing[2]     = 'deny read/write'
  15. sharing[3]     = 'deny write'
  16. sharing[4]     = 'deny read'
  17. sharing[5]     = 'deny none'
  18. access[1]      = 'read'
  19. access[2]      = 'write'
  20. access[3]      = 'read/write'
  21.  
  22. @ 0,6 SAY 'OPEN FILE TEST PROGRAM: test DOS open modes ' + ;
  23.           'using Clipper FOPEN()'
  24. @ 2,2 SAY CHR(179) + CHR(17) + REPLICATE(CHR(196), 10) + ;
  25.    "Open Mode byte (DOS INT21 function 3Dh, 'Open File')" ;
  26.    + REPLICATE(CHR(196), 10) + CHR(16) + CHR(179)
  27. @ 3,2 SAY  'Inheritance      Sharing Mode' + ;
  28.    '           Reserved        Access Mode'
  29. @ 4,2 SAY  'bit field        bit field' + ;
  30.    '              bit field       bit field'
  31. @ 7,3 SAY '-                - - -                  0' + ;
  32.           '               - - -'
  33. @ 6,2 TO 8,4
  34. @ 6,19 TO 8,21
  35. @ 6,21 TO 8,23
  36. @ 6,23 TO 8,25
  37. @ 6,42 TO 8,44
  38. @ 6,58 TO 8,60
  39. @ 6,60 TO 8,62
  40. @ 6,62 TO 8,64
  41.  
  42. box_menu(9, 2, inheritance, .F., .F.)
  43. box_menu(9, 19, sharing, .F., .F.)
  44. box_menu(9, 58, access, .F., .F.)
  45.  
  46. m_inheritance = box_menu(9, 2, inheritance, .F.) - 1
  47. @ 7,3 SAY IIF(m_inheritance = 1, '1', '0')
  48.  
  49. m_sharing = box_menu(9, 19, sharing, .F.) - 1
  50. @ 7,20 SAY IIF(m_sharing = 4, '1', '0')
  51. @ 7,22 SAY IIF(m_sharing = 2 .OR. m_sharing = 3, '1', '0')
  52. @ 7,24 SAY IIF(m_sharing = 1 .OR. m_sharing = 3, '1', '0')
  53.  
  54. m_reserved = 0
  55.  
  56. m_access = box_menu(9, 58, access, .F.) - 1
  57. @ 7,59 SAY '0'
  58. @ 7,61 SAY IIF(m_access = 2, '1', '0')
  59. @ 7,63 SAY IIF(m_access = 1, '1', '0')
  60.  
  61. * Calculate open mode based on contribution
  62. * from each subfield.
  63. open_mode = m_inheritance * 128 + ;
  64.             m_sharing     *  16 + ;
  65.             m_reserved    *   8 + ;
  66.             m_access      *   1
  67. @ 7,70 SAY "= "+LTRIM(TRIM(STR(open_mode)))+;
  68.    ' dec.'
  69.  
  70. file = choose_file(12, 31, '', '*')
  71.  
  72. hndl = FOPEN(file,open_mode)  && Try it and
  73.                         ** see what happens!
  74. @ 19,0 SAY 'Clipper command  FOPEN("'+ file +;
  75.    '",'+ LTRIM(STR(open_mode)) + ')'
  76. IF hndl = -1
  77.   @ 19,COL() SAY ' <== Failed with DOS error ';
  78.    + LTRIM(STR(FERROR())) + '.'
  79.    IF FILE("DOSERRS.DBF")
  80.       old_area = SELECT()
  81.       SELECT 0
  82.       USE DOSErrs
  83.       GOTO FERROR()
  84.       @ 20,0 SAY TRIM(err_msg)
  85.       USE  
  86.       SELECT(old_area)
  87.    END
  88. ELSE
  89.    @ 19,COL() SAY ' <== Succeeded, gaining '+;
  90.       'DOS handle ' + LTRIM(STR(hndl)) + '.' 
  91.    SET COLOR TO i/n
  92.    @ 21,15 SAY "Holding  " + file + "  open"+;
  93.       " in mode you specified."
  94.    SET COLOR TO w/n
  95.    @ 22,15 SAY "Press any key to close file"+;
  96.       " and quit. "
  97.    SET CURSOR OFF
  98.    INKEY(0)
  99.    SET CURSOR ON
  100.    @ 21,15 CLEAR TO 22,79
  101. END
  102. @ 23,0
  103.  
  104.  
  105. * Function: Box_menu()
  106. * Note(s):  Display item list in a box.
  107. *           Optionally select among items
  108. *           with MENU TO.
  109. *
  110. * box_menu(<expN1>,<expN2>,<array>,
  111. *    [<expL1>,[<expL2>]])
  112. *
  113. * expN1,expN2 coordinates of box upper-left
  114. *   corner.
  115. * array contains choices (box height
  116. *   accordingly, no scrolling).
  117. * expL1 determines whether to restore
  118. *   overwritten screen region.
  119. * expL2 determines whether to perform MENU TO
  120. *   selection.
  121. *
  122. FUNCTION box_menu
  123. PARAMETERS top, left, promts, restscr, do_menu
  124. do_menu = IIF(PCOUNT() < 5, .T., do_menu)
  125. restscr = IIF(PCOUNT() < 4, .T., restscr)
  126. PRIVATE choice, max_promt, row, winbuff
  127. max_promt = LEN(promts[1])
  128. FOR f = 2 TO LEN(promts)
  129.    max_promt = MAX(LEN(promts[f]), max_promt)
  130. NEXT
  131. IF restscr
  132.    winbuff = SAVESCREEN(top, left, top + ;
  133.       LEN(promts) + 1, left + max_promt + 4)
  134. END
  135. @ top,left CLEAR TO top + LEN(promts) + 1,;
  136.    left + max_promt + 4
  137. @ top,left TO top + LEN(promts) + 1, left +;
  138.    max_promt + 4
  139. FOR row = top + 1 TO top + LEN(promts)
  140.    IF do_menu
  141.       @ row,left + 2 PROMPT promts[row-top]
  142.    ELSE
  143.       @ row,left + 2 SAY promts[row-top]
  144.    END
  145. NEXT
  146. IF do_menu
  147.    MENU TO choice
  148. END
  149. IF restscr
  150.    RESTSCREEN(top, left, top+LEN(promts)+1,;
  151.       left+max_promt+4, winbuff)
  152. END
  153. RETURN IIF(do_menu, choice, '')
  154.  
  155.  
  156. * Function: Choose_file()
  157. * Note(s):  Solicit a filename, either by
  158. *           ACHOICE() or GET/READ, in a box.
  159. *
  160. * choose_file(<expN1>,<expN2>,[<expC1>,
  161. *    [<expC2>]])
  162. *
  163. * expN1,expN2 coordinates of box upper-left
  164. *   corner.
  165. * expC1 prompt message, either SAYed if GET,
  166. *   or below window if ACHOICE().  If none or
  167. *   null, defaults to "Select a file."
  168. * expC2 determines by presence or absence
  169. *   whether to use ACHOICE() or GET.  If
  170. *   present, limits field of ACHOICE()'s
  171. *   candidate filenames to a filename
  172. *   extension.  Pass "*" to get all files,
  173. *   "" to get extensionless ones.
  174. *
  175. FUNCTION choose_file
  176. PARAMETERS t, l, prompt, extension
  177. PRIVATE file, filename, no_files, winbuff
  178. prompt = IIF(PCOUNT() < 3, ;
  179.    'Select a file', ;
  180.    IIF('' = prompt, 'Select a file', prompt))
  181. IF PCOUNT() >= 4
  182.    no_files = ADIR("*.&extension.")
  183.    IF no_files = 0
  184.       RETURN ''
  185.    END
  186.    PRIVATE files[no_files]
  187.    ADIR("*.&extension.", files)
  188.    winbuff = SAVESCREEN( t, l, t+13,;
  189.       l+MAX(14, LEN(prompt)))
  190.    @ t,l CLEAR TO t + 13, l + 14
  191.    @ t,l TO t + 10, l + 14
  192.    @ t+12,l+1 SAY prompt
  193.    file = ACHOICE(t+1,l+1, t+9, l+13, files)
  194.    RESTSCREEN(t, l, t+13, ;
  195.       l+MAX(14, LEN(prompt)), winbuff)
  196.    RETURN IIF(file > 0, files[file], '')
  197. ELSE
  198.    filename = '            '
  199.    winbuff = SAVESCREEN(t, l, t+2, l+30)
  200.    @ t,l CLEAR TO t+2, l+30
  201.    @ t,l TO t+2, l+30
  202.    @ t+1,l+1 SAY prompt GET filename
  203.    READ
  204.    filename = ALLTRIM(filename)
  205.    RESTSCREEN(t, l, t+2, l+30, winbuff)
  206.    RETURN IIF(!EMPTY(filename), filename, '')
  207. END
  208.